Your Choice 3/Your Choice Software Collection 3.iso/prgmming/atbus/atbus.pas

Pascal/Delphi Source File | 1994-01-25 | 10.4 KB | 302 lines

{---------------------------------------------------------------------------
  PROGRAM :       ATBUS                           INITIAL : 19910404 v 1.00
  PROJECT :       ATBUS                           UPDATE :  19940126 v 1.02
  AUTHOR :        Martin Gerdes
                  English version by Jeroen W. Pluimers
                  internet: [e-mail]
                  compuserve: 100013,1443

  DESCRIPTION :   Describe AT-BUS hard-disk parameters

  HISTORY :       19910404 - 1.00 - initial German Version
                  19920205 - 1.01 - initial English Version
                  19940126 - 1.02 - added string endian reversion
                                    (some HD-manufacturers have strings
                                     with little-endian, others encode
                                     with big-endian)

  COMPUTER :      ERC 386/25; BSE 486/50
  COMPILER :      Turbo Pascal 6.0; Borland Pascal 7.01

  COPYRIGHT :     Original version (c) Martin Gerdes und c't 1991
                  English version (c) 1991 Pluimers Software Ontwikkeling.
 ---------------------------------------------------------------------------}

program AtBus;

{$A+,B-,D+,E+,F-,I+,L+,N-,O-,R-,S-,V-,X+}
{$M 2048,0,0}

var
  ExitSave    :Pointer;

const
  ide_Data        = $1F0;
  ide_Error       = $1F1;
  ide_SectorCount = $1F2;
  ide_Sector      = $1F3;
  ide_CylinderLo  = $1F4;
  ide_CylinderHi  = $1F5;
  ide_DriveAndHead= $1F6;
  ide_Status      = $1F7;
  ide_Command     = $1F7;

const
  icf_Reserved                        = $0001;
  icf_HardSectored                    = $0002;
  icf_SoftSectored                    = $0004;
  icf_NoCodingMFM                     = $0008;
  icf_SeekTime15mu                    = $0010;
  icf_CanTurnMotorOff                 = $0020;
  icf_IsFixedDisk                     = $0040;
  icf_IsRemovableDisk                 = $0080;
  icf_LessThan5Mbs                    = $0100;
  icf_5MbsInside10Mbs                 = $0200;
  icf_MoreThan10Mbs                   = $0400;
  icf_RotationToleranceHalfPercent    = $0800;
  icf_HasDataStrobeOffsetOption       = $1000;
  icf_HasTrackOffsetOption            = $2000;
  icf_RequiresFormatSpeedToleranceGap = $4000;
  icf_IsNonMagneticDrive              = $8000;

  ict_NotSpecified                         = 0;
  ict_SinglePortedSingleSectorBuf          = 1;
  ict_DualPortedMultipleSectorBuf          = 2;
  ict_DualPortedMultipleSectorBufReadAhead = 3;

type
  Char8  = array [0..7 ] of Char;
  Char20 = array [0..19] of Char;
  Char40 = array [0..39] of Char;
  tDescIDE = Record
    ConfigFlags:        Word;   { see icf_xxx constants }
    FixedCylinders:     Word;
    RemovableCylinders: Word;
    Heads:              Word;
    BytesPerTrack:      Word;
    BytesPerSector:     Word;
    SectorsPerTrack:    Word;
    d1,d2,d3:           Word;
    SerialNumber:       Char20;
    ControllerType:     Word;   { see ict_xxx constants }
    SectorsInBuffer:    Word;   { each sector is 512 bytes }
    ECCBytes:           Word;
    ControllerRevision: Char8;
    ControllerModel:    Char40;
    SectorsPerInterupt: Word;
    DoubleWordFlag:     Word;
    IsWriteProtected:   Word;
    reserved:           array [50..255] of Word;
  end;

function Byte2Hex(h:byte):string;
const
  hexarray: array [0..15] of char = '0123456789abcdef';
begin
  Byte2Hex:=hexarray[h shr 4]+hexarray[h and $f];
end;

function Word2Hex(h:word):string;
begin
  Word2Hex:=Byte2Hex(hi(h)) + Byte2Hex(lo(h));
end;

function GetConfigFlag (Flag: Word): String;
var
  s : String;
begin
  case Flag of
    icf_Reserved                       : s := 'has reserved flag';
    icf_HardSectored                   : s := 'is hard-sectored';
    icf_SoftSectored                   : s := 'is soft-sectored';
    icf_NoCodingMFM                    : s := 'has no MFM encoding';
    icf_SeekTime15mu                   : s := 'has seek time > 15 µs';
    icf_CanTurnMotorOff                : s := 'can turn off drive motor';
    icf_IsFixedDisk                    : s := 'has a permanent hard-disk';
    icf_IsRemovableDisk                : s := 'has a removable disk';
    icf_LessThan5Mbs                   : s := 'has a transferrate <= 5 Mb/s';
    icf_5MbsInside10Mbs                : s := 'has a transferrate > 5 Mb/s and <= 10 Mb/s';
    icf_MoreThan10Mbs                  : s := 'has a transferrate > 10 Mb/s';
    icf_RotationToleranceHalfPercent   : s := 'has a rotation speed tolerance > 0.5%';
    icf_HasDataStrobeOffsetOption      : s := 'has a data strobe offset option available';
    icf_HasTrackOffsetOption           : s := 'has a track offset option available';
    icf_RequiresFormatSpeedToleranceGap: s := 'has a format speed tolerance gap required';
    icf_IsNonMagneticDrive             : s := 'is a non-magnetic drive'
    else                                 s := 'an invalid flag : '+Word2Hex(Flag);
  end;
  GetConfigFlag := s;
end;

function GetControllerType (Controller: Word): String;
var
  s : String;
begin
  Case Controller of
    ict_NotSpecified                         : s := 'not specified';
    ict_SinglePortedSingleSectorBuf          : s := 'single ported single sector buffer';
    ict_DualPortedMultipleSectorBuf          : s := 'dual ported multiple sector buffer';
    ict_DualPortedMultipleSectorBufReadAhead : s := 'dual ported multiple sector buffer with look-ahead read capabilities';
  end;
  GetControllerType := s;
end;

Function StripString (s: String): String;
Begin
  while (s[length(s)]=#0) and (length(s)<>0) do
    delete(s,length(s),1);
  StripString := '>'+s+'<';
End;

function StrChangeEndian(s: String): String;
  { change from big-endian words into little-endian words }
var
  i: byte;
  c: char;
begin
  for i := 1 to length(s) do if not odd(i) then begin
    c := s[i];
    s[i] := s[i-1];
    s[i-1] := c;
  end;
  StrChangeEndian := s;
end;

{$F+} procedure MyExit; {$F-}
{ reset disk parameters so other disk operations won't be desturbed in case
  of program abort }
begin
  Port[ide_Command]:=$10;      { send command: reset current drive }
  Port[ide_DriveAndHead]:=$a0; { select drive 0, head 0 }
  Port[ide_Command]:=$10;      { send command: reset current drive }
  ExitProc := ExitSave;        { restore previous exitproc }
end;

function ReadIDE (Var DescIDE: tDescIDE): Boolean; assembler;
asm
  cld                     { string direction forward }
  les   di, [DescIDE]     { load description table into destination }
  mov   dx, ide_Command
  mov   al, 0ECh
  out   dx, al
  jmp   @@0
@@0:
  mov   cx, 0
@@Loop1:
  in    al, dx            { wait until the controller says its ready }
  and   al, 08h
  jnz   @@GotDesc
  loop  @@Loop1
  mov   ax, False         { indicate failure }
  mov   cx, 100h          { and fill table with 0 }
  rep   stosw
  jmp   @@Exit
@@GotDesc:
  mov   cx, 100h          { get 0100h words }
  mov   dx, ide_Data
@@Loop2:
  in    ax, dx
  stosw
  loop  @@Loop2
  mov   al, true
@@Exit:
end;

procedure ResetCurrentDrive;
begin
  Port [ide_Command] := $10;
end;

function SetDrive (Drive: Char): Boolean;
begin
  SetDrive := true;
  case Drive of
    'C': port[ide_DriveAndHead] := $a0;
    'D': port[ide_DriveAndHead] := $b0;
  else
    SetDrive := false; { only two IDE drives allowed }
  end;
end;

procedure WriteReport(Drive:Char);
  { ask status of drive and report it }
var
  i           :Word;
  ch          :Char;
  boo         :Boolean;
  TotalSectors:LongInt;

  DescIDE : tDescIDE;
begin
  Drive := Upcase(Drive);
  Writeln;
  Writeln('Disk-drive ',Drive,':');
  Writeln('═════════════');

  If not SetDrive (Drive) then exit;

  boo := ReadIDE (DescIDE) and ((Port[ide_Status] and 1) = 0);

  { before doing output, reset to drive D: so output
    redirection will function properly }

  SetDrive ('C');
  ResetCurrentDrive;

  if boo Then
    with DescIDE do begin
      Writeln('Configuration              : $', Word2Hex(ConfigFlags));
      for i := 0 TO 15 do
        if ConfigFlags and (1 shl i) <> 0 then
            Writeln ('  '+GetConfigFlag(1 shl i));
      Writeln;

      Writeln('Number of cylinders on');
      Writeln(' non-removable medium      : ',FixedCylinders);
      Writeln(' removable medium          : ',RemovableCylinders);
      Writeln('Number of heads            : ',Heads);
      Writeln('Bytes per track            : ',BytesPerTrack);
      Writeln('Bytes per sector           : ',BytesPerSector);
      Writeln('Sectors per track          : ',SectorsPerTrack);
      Writeln('d1                         : ',Word2Hex(d1));
      Writeln('d2                         : ',Word2Hex(d2));
      Writeln('d3                         : ',Word2Hex(d3));
      Writeln('Serial number              : ',StripString(SerialNumber));
      Writeln('                             ',StripString(StrChangeEndian(SerialNumber)));
      Writeln('Controller type            : ',GetControllerType(ControllerType));
      Writeln('Buffersize in sectors      : ',SectorsInBuffer);
      Writeln('Number of ECC-bytes        : ',ECCBytes);
      Writeln('Controller Revision        : ',StripString(ControllerRevision));
      Writeln('                             ',StripString(StrChangeEndian(ControllerRevision)));
      Writeln('Controller model           : ',StripString(ControllerModel));
      Writeln('                             ',StripString(StrChangeEndian(ControllerModel)));
      Writeln('Sectors per interrupt      : ',SectorsPerInterupt);
      Writeln('Double word flag           : ',DoubleWordFlag);
      Writeln('Write protect flag         : ',IsWriteProtected);
      Writeln;
      TotalSectors:=LongInt(FixedCylinders+RemovableCylinders) *
                    LongInt(Heads) * LongInt(SectorsPerTrack);
      Writeln('Total sectors              : ',TotalSectors);
      Writeln('Total capacity (Megabytes) : ',TotalSectors DIV 2048);
      { 512 byte per sector -> 2048 sectors per megabyte }

      For i := 50 to 255 do if reserved[i] <> 0 then
      Writeln('Reserved',i:7,'            : ',Reserved[i]);
    end { with }
  else
    Writeln('is not available.');
END;
  {----------------------------------------------------}

BEGIN
  ExitSave:=ExitProc;
  ExitProc:= @MyExit;

  Writeln('*** ATBUS ***  04.04.91 -mat 19940126 -jwp');
  Writeln('A program that shows disk-drive parameters from IDE disks');

  WriteReport('c');
  WriteReport('d');
  Writeln;
END.